home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
EnigmA Amiga Run 1997 April
/
EnigmA AMIGA RUN 17 (1997)(G.R. Edizioni)(IT)[!][issue 1997-04][EAR-CD].iso
/
EARCD
/
comm
/
tcp
/
AbDial.lha
/
abdial.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1996-12-06
|
15KB
|
746 lines
/* ABCS dialup V1.25 */
options RESULTS
options FAILAT 25
/* MAIN */
MainInit()
ScriptName = arg(1)
Signal on break_c
if (show('p','ABDIALHOST')~=0) then AbCloseWindow()
AbOpenWindow()
AbSetState("OPEN")
result=open('scriptfh',ScriptName,'R')
if (result==0) then AbExit('Could not open script '||scriptname,25)
ok=1
do while (eof('scriptfh')==0)
line=readln('scriptfh')
comm=upper(word(line,1))
if (comm=='//') then NOP
if (comm=='SERBAUD') then AbSerBaud(AbWords(line,2,60))
if (comm=='SERDEV') then AbSerDev(AbWords(line,2,60))
if (comm=='SEROPT') then AbSerOpt(AbWords(line,2,60))
if (comm=='INIT') then AbInit(AbWords(line,2,60))
if (comm=='FLUSH') then AbFlush(AbWords(line,2,60))
if (comm=='DIAL') then AbDial(AbWords(line,2,1),AbWords(line,3,60))
if (comm=='DELAY') then AbDelay(AbWords(line,2,60))
if (comm=='WAIT') then AbWait(AbWords(line,2,1),AbWords(line,3,60))
if (comm=='GETIP') then AbGetIP(AbWords(line,2,1),AbWords(line,3,60))
if (comm=='SEND') then AbSend(AbWords(line,2,60))
if (comm=='SEND2') then AbSend2(AbWords(line,2,60))
if (comm=='HANGUP') then AbHangup(AbWords(line,2,60))
end
AbExit("",0)
/******************************************************************************/
/* script functions */
/******************************************************************************/
AbInit:
AbFlush()
s2=arg(1)
AbSetState("INIT")
AbSerWriteln(s2)
i=ABCS_WaitStr("OK",10,1)
if (i~=0) then AbSetResult("OK")
return 0
AbFlush:
SerData=""
return 0
AbDial:
Provider = arg(1)
Number = arg(2)
Connected = 0
Status = 0
DialMode = 1
AbSetTimer(0,60)
do forever
if (Status == 0) then
do
AbSetState("DIAL "||Provider)
AbSerWriteln(dialstr||number)
String = ''
Status = 25
Count = 0
end
ABCSDelay(50)
AbSetTimer(count,60)
String=String||AbSerRead()
if (status ~= 0) then
do
status = TestString(String)
end
if (status == 601) then leave
if (status == 602) then
do
status = 0
AbSetResult("BUSY")
end
if (status == 603) then
do
status = 0
AbSetResult("NO CARRIER")
end
if (status == 604) then
do
status = 0
AbSetResult("NO DIALTONE")
end
if (count == 60) then
do
status = 0
AbSetResult("MODEM NOT RESPONDING")
end
count = count + 1
end
DialMode = 0
connect = 1
parse var String .'CONNECT ' speed+5 +2 String
AbSetResult('CONNECT '||speed)
return 0
AbDelay:
delayvalue=arg(1)
if ((verify(delayvalue,"0123456789")~=0) | (delayvalue=="")) then delayvalue=1
AbSetState("DELAY")
AbShowDelay(delayvalue*50)
AbSetResult("")
return 0
AbSend:
senddata=arg(1)
AbSerWriteln(senddata)
return 0
AbSend2:
senddata=arg(1)
AbSerWrite(senddata)
return 0
AbWait:
t=arg(1)
s=arg(2)
if (verify(t,"0123456789")~=0) then
do
if (s~="") then s=" "||s
s=t||s
t=25
end
ABCS_Waitstr(s,t,0)
return 0
AbGetIP:
var=arg(1)
s=arg(2)
if (var=="") then var="AbcsIP"
if (s=="") then s="address"
i=1
pos=1
found=0
do while (i<length(SerData))
if (substr(SerData,i,length(s))==s) then
do
pos=i+length(s)
found=1
end
i=i+1
end
do while ((substr(SerData,pos,1)==" ") & (pos<length(SerData)))
pos=pos+1
end
string=substr(SerData,pos,length(SerData)-pos+1)
parse var string a '.' b '.' c '.' d '.' .
slip_ip = a||'.'||b||'.'||c||'.'||AbcsStripCr(d)
slip_ip = AbcsStripCr(slip_ip)
AbSetResult(slip_ip)
address command
'setenv '||var||' "'||slip_ip||'"'
return 0
AbSerBaud:
i=arg(1)
if ((verify(i,"0123456789")~=0) | (i=="")) then i=SerialBaud
SerialBaud=i
return 0
AbSerDev:
s=arg(1)
if (length(s)==0) then s=SerialDevice
SerialDevice=s
return 0
AbSerOpt:
s=arg(1)
if (length(s)~=3) then s=SerialOpts
SerialOpts=s
return 0
AbHangUp:
state=0
count=0
AbSetState("HANGUP LINE")
do while ((state~=25) & (count<25))
if (state<3) then
do
ABCSDelay(50)
if (state==0) then
do
AbSerWriteln('at')
result=ABCS_Waitstr('OK',2,2)
state=1
if (result~=0) then state=3
end
else
do
Delay(10)
AbSerWrite('+')
Delay(10)
AbSerWrite('+')
Delay(10)
AbSerWrite('+')
result=ABCS_Waitstr('OK',3,2)
state=state+1
end
end
else
do
AbSerWriteln('ATH0')
result=ABCS_Waitstr('OK',5,2)
if (result~=0) then state=25
else state=0
end
count=count+1
if (state==1) then AbSetResult('DATA MODE')
if (state==2) then AbSetResult('COMMAND MODE')
if (state==25) then AbSetResult('OK')
if (count==25) then AbSetResult('FAIL')
end
return 0
/******************************************************************************/
/* support functions */
/******************************************************************************/
MainInit:
'scriptfh' = 0
cr = '0d'x
crlf = d2c(13)||d2c(10)
lf = d2c(10)
SerialDevice = 'serial.device'
SerialBaud = 57600
SerialOpts = '8N1'
scriptname = 'abcs.scr'
dialstr = 'atdt'
buffer = 0
SerData = ""
connected = 0
GuiOpen = 0
DialMode = 0
serh = 0
AbErrorMode = 25
if ~open('stdout','*') then Exit(25)
if ~show('L',"rexxsupport.library") then
if ~addlib('rexxsupport.library', 0, -30, 0) then AbExit('Could not open rexxsupport.library',25)
if ~show('L', "rexxserdev.library") then
if ~addlib( 'rexxserdev.library', 0, -30, 0) then AbExit('Could not open rexxserdev.library',25)
SerBufC = AllocMem(6000)
if (SerBufC == 0) then AbExit("Could not alloc memory",27)
SerBuf = c2d(SerBufC)
return 0
AbWords:
str=arg(1)
pos=arg(2)
nr =arg(3)
i=1
dir=1
num=1
res=""
quote=0
skip=0
do while (i<=length(str))
cl=c
c=substr(str,i,1)
if ((c=='\') & (dir==1)) then dir=0
else
do
if (dir==0) then dir=1
else
do
if (c=='"') then
do
quote=1-quote
skip=1
end
if ((c==' ') & (quote==0)) then
do
num=num+1
if (num==pos) then skip=1
end
end
end
if ((num>=pos) & (num<=pos+nr-1) & (skip==0)) then res=res||c
skip=0
i=i+1
end
res=AbConv(res)
return res
AbConv:
s=arg(1)
r=""
i=1
mode=0
do while (i<=length(s))
c=substr(s,i,1)
if (mode==1) then
do
if (substr(s,i,1)=='n') then r=r||crlf
else if (substr(s,i,1)=='r') then r=r||cr
else if (substr(s,i,1)=='l') then r=r||lf
else r=r||c
mode=0
end
else
do
if (c=='\') then mode=1
else r=r||c
end
i=i+1
end
return r
AbSerWrite:
s=arg(1)
AbSerOpen()
if (serh~=0) then
do
SerWrite(serh, s, length(s))
end
return 0
AbSerWriteln:
s=arg(1)
AbSerOpen()
AbSerWrite(s||crlf)
return 0
AbSerRead:
s=""
AbSerOpen()
if (serh~=0) then
do
stat = SerQuery(serh)
parse upper var stat valid rbytes .
s=SerRead(serh, SerBuf, rbytes)
end
SerData=SerData||s
return s
break_c:
Signal off break_c
AbExit('DIALUP ABORTED',60)
return 0
ReDial:
if (DialMode==1) then
do
AbSerWriteln('')
ABCSDelay(50)
Status=0
end
Return 0
AbCleanup:
if (serh~=0) then AbSerWriteln('')
if connected ~= 0 then
do
AbHangUp()
end
AbSerClose()
if (SerBufC~=0) then FreeMem(SerBufC,4096)
AbCloseWindow()
return 0
AbExit:
txt=arg(1)
code=arg(2)
if (txt~="") then ABWriteln(txt)
AbCleanup()
exit code
return 0
ABCS_WaitStr:
teststr = arg(1)
timeout = arg(2)
quiet = arg(3)
check = 0
initlength = length(SerData)
if (quiet==0) then AbSetState('WAIT : '||teststr)
i=0
AbSetTimer(i,timeout)
do until ((check ~= 0) | (i>=timeout))
s=AbSerRead()
check = pos(teststr,SerData)
ABCSDelay(25)
s=AbSerRead()
i=i+1
AbSetTimer(i,timeout)
end
if ((check == 0) & (quiet~=2)) then
do
AbSetResult("TIMEOUT")
ABWriteError('UNEXPECTED DATA : '||crlf||substr(SerData,initlength+1,length(SerData)-initlength))
end
else if (quiet==0) then AbSetResult("OK")
return check
TestString:
teststr = arg(1)
if (pos('CONNECT' , teststr) ~= 0) then return 601
if (pos('BUSY' , teststr) ~= 0) then return 602
if (pos('NO CARRIER', teststr) ~= 0) then return 603
if (pos('NO DIALTONE', teststr) ~= 0) then return 604
return 25
ABCSDelay:
len = arg(1)
Delay(len)
AbCheckMessages()
Return 0
AbShowDelay:
delaylen = arg(1)
i=0
do while (i<=delaylen)
AbSetTimer(i,delaylen)
i=i+25
ABCSDelay(10)
end
return 0
AbWriteError:
errorstr = arg(1)
nstr = ''
errorlc = ''
do errorpos = 1 to length(errorstr)
errorc = substr(errorstr,errorpos,1)
if ((errorlc == lf) & (errorc = lf)) then errorc = ''
if (errorc == cr) then errorc = lf
nstr = nstr || errorc
errorlc = errorc
end
if Open('ABCS','CON:0/25//105/ABCS TCP-IP DIALUP V1.0/CLOSE/WAIT','WRITE') then
do
writeln('ABCS',nstr)
Delay(25)
Close('ABCS')
end
Return 0
AbcsStripCr:
str = arg(1)
s = ''
i = 1
ok = 1
do while (i<=length(str)) & (ok == 1)
c1 = substr(str,i,1)
if ((c1 == cr) | (c1 == lf)) then ok=0
else s = s||c1
i=i+1
end
return s
ABWrite:
s = arg(1)
writech('stdout',s)
return 0
ABWriteln:
s = arg(1)||lf
writech('stdout',s)
return 0
AbSerOpen:
if (serh==0) then
do
AbErrorMode=60
serh = SerOpen(SerialDevice, 0)
AbcsDelay(250)
if (serh == 0) then failure()
AbErrorMode=25
SerClear(serh)
SerSetParms(serh, SerialBaud, substr(SerialOpts,1,1), substr(SerialOpts,2,1), substr(SerialOpts,3,1), 0, 25000, 4096)
end
return 0
AbSerClose:
if (serh~=0) then
do
SerClose(serh)
serh=0
end
return 0
/******************************************************************************/
/* gui functions */
/******************************************************************************/
AbOpenWindow:
if ~show('l', "rexxarplib.library") then
if ~addlib('rexxarplib.library',0,-30,0) then AbExit('Could not open rexxarplib.library',25)
if ~show('l', "rexxsupport.library") then
if ~addlib('rexxsupport.library',0,-30,0) then AbExit('Could not open rexxsupport.library',25)
drop AbDialPort
Call OPENPORT(AbDialPort)
drop AbDialHost
ADDRESS COMMAND 'Run >nil:' 'SYS:Rexxc/rx ''Call createhost(AbDialHost, AbDialPort,)'''
ok='0'
i=25
do while (ok=='0')
ok=show('p','ABDIALHOST')
Call delay(10)
i=i-1
if (i==0) then
do
AbDialHost=0
AbExit("Unable to create host",28)
end
end
idcmp = 'CLOSEWINDOW+GADGETUP'
flags = 'WINDOWCLOSE+WINDOWDRAG+WINDOWDEPTH'
posx = ScreenCols('Workbench')-325
posy = ScreenRows('Workbench')-125
posx = trunc(posx/2)
posy = trunc(posy/2)
result = OpenWindow(AbDialHost, posx, posy, 325, 125, idcmp, flags, "ABCS DIALUP V1.25 (C) ABCS 1996")
if (result==0) then AbExit("Unable to open window",29)
call SetAPen(AbDialHost,1)
result = SetFont(AbDialHost, 'topaz.font', 8,0,2,8)
call AddGadget(AbDialHost, 20, 23, 00, " ABCS DIALUP V1.25 ", "ABCS")
call Move(AbDialHost,25,53)
call Text(AbDialHost,"STATE : ")
call Move(AbDialHost,25,68)
call Text(AbDialHost,"RESULT : ")
call Move(AbDialHost,25,83)
call Text(AbDialHost,"TIME : ")
call AbDrawBox(96,75,305,86)
call AddGadget(AbDialHost, 20, 98, 01, " REDIAL ","REDIAL")
call AddGadget(AbDialHost, 172, 98, 02, " ABORT ","ABORT")
GuiOpen = 1
RETURN 0
AbCloseWindow:
if (AbDialHost~=0) then call Exit(AbDialHost)
if (AbDialPort~=0) then call ClosePort(AbDialPort)
return 0
AbDrawBox:
x = arg(1)
y = arg(2)
x2= arg(3)
y2= arg(4)
call SetAPen(AbDialHost,1)
Move(AbDialHost,x,y2-1)
Draw(AbDialHost,x,y)
Draw(AbDialHost,x2-1,y)
call SetAPen(AbDialHost,2)
Move(AbDialHost,x2,y+1)
Draw(AbDialHost,x2,y2)
Draw(AbDialHost,x+1,y2)
call SetAPen(AbDialHost,1)
return 0
AbCheckMessages:
CheckOk=1
R=1
do while (CheckOk==1)
p=GETPKT(AbDialPort)
if (p='0000 0000'x) then
do
CheckOk=0
end
else
do
command=GETARG(p)
t=REPLY(p,0)
PARSE VAR command arg1' 'arg2' 'arg3' 'arg4' '
if ((arg1=='CLOSEWINDOW') | (arg1=="ABORT")) THEN
do
AbSetState("ABORT")
AbSetResult("")
AbExit("",60)
end
if (arg1=="REDIAL") THEN
do
Redial()
end
if (arg1=="ABCS") THEN
do
AbcsMessage()
end
end
end
return r
AbSetTimer:
pos=arg(1)
max=arg(2)
if (max<1) then max=1
if (pos>max) then pos=max
x1=97
y1=76
x2=x1+((304-97)*pos)/max
y2=85
x3=304
call SetAPen(AbDialHost,3)
call RectFill(AbDialHost,x1,y1,x2,y2)
call SetAPen(AbDialHost,0)
if (x2<x3) THEN call RectFill(AbDialHost,x2+1,y1,x3,y2)
call SetAPen(AbDialHost,1)
return 0
AbSetState:
s=arg(1)
s=substr(s,1,25," ")
call SetAPen(AbDialHost,1)
call Move(AbDialHost,96,53)
call Text(AbDialHost,s)
return 0
AbSetResult:
s=arg(1)
s=substr(s,1,25," ")
call SetAPen(AbDialHost,1)
call Move(AbDialHost,96,68)
call Text(AbDialHost,s)
return 0
AbcsMessage:
abtxt=""
abtxt=abtxt||crlf
abtxt=abtxt||"ABCS DIALUP V1.25"||crlf
abtxt=abtxt||"(C) ABCS 1996"||crlf
abtxt=abtxt||crlf
abtxt=abtxt||"THIS PROGRAM MAY BE SPREAD/COPIED/USED"||crlf
abtxt=abtxt||"UNDER THE FOLLOWING RESTRICTIONS :"||crlf
abtxt=abtxt||crlf
abtxt=abtxt||"YOU DO NOT CHANGE ANYTHING IN IT AND DO"||crlf
abtxt=abtxt||"NOT CHARGE ANYTHING FOR COPYING THIS PROGRAM."||crlf
AbWriteError(abtxt)
return 0